home *** CD-ROM | disk | FTP | other *** search
/ Fritz: All Fritz / All Fritz.zip / All Fritz / FILES / PROGBLER / ASMCODE.LZH / PREVIEW.PAS < prev    next >
Pascal/Delphi Source File  |  1984-07-21  |  3KB  |  108 lines
  1. {  $PAGESIZE:80,$LIST+, $DEBUG+, $BRAVE+, $LINESIZE:132, $OCODE+   }
  2. {  $NILCK+, $MATHCK+, $RANGECK+, $INITCK+, $INDEXCK+, $ENTRY+    }
  3. {  $LINE+, $RUNTIME+, $SYMTAB+, $WARN+, $GOTO+     }
  4. {  $TITLE:'WCOUNT.PAS  (VOL-ID:  MSB-PASSCRATCH)  --  WRDCOUNT PROG'}
  5. {  $SUBTITLE:'PROGRAM FOR CHECKING CONTENTS OF ASCII FILES'}
  6. {  $MESSAGE:'PASCAL - COMPILATION OPTIONS SET'     }
  7. {  $MESSAGE:'SYSTEM - COMPILATION BEGINS'          }
  8.  
  9. { $LIST-}
  10. { $INCLUDE:'A:FILKQQ.INC'}
  11. { $INCLUDE:'A:FILUQQ.INC'}
  12. { $LIST+}
  13.  
  14. PROGRAM WRDCNT (INPUT,OUTPUT);  USES FILUQQ,FILKQQ;
  15.  
  16. CONST
  17.   WRDLEN   = 20; {MAX WRD LENGTH}
  18.   BLANK    = ' ';   {A BLANK CHAR}
  19.   PGLINES  = 66;
  20.  
  21.  
  22. TYPE
  23.   ALFASET = SET OF CHAR;
  24.  
  25. VAR
  26.   NEW_WRD :  LSTRING(WRDLEN);
  27.   SOURCE   :  TEXT;    {SOURCE FILE}
  28.   PGCNT, LNCNT,  WDCNT, CHCNT : WORD;
  29.   ALPHA : ALFASET;
  30.   CMDLINE : LSTRING (80); {80 CHARS FOR THE COMMAND LINE ENOUGH}
  31.   CURTIME, CURDATE : STRING(10);
  32.  
  33. PROCEDURE DATE (VAR S:STRING); EXTERN;    {LIBR FUNCTION}
  34. PROCEDURE TIME (VAR S:STRING); EXTERN;    {LIBR FUNCTION}
  35. PROCEDURE ENDXQQ; EXTERN;
  36.  
  37. PROCEDURE INITIALIZE;
  38. VAR
  39.   ERROR : WORD;
  40. BEGIN
  41.   ALPHA  := ['A'..'Z','a'..'z', '_', '$'];
  42.   TIME (CURTIME);
  43.   DATE (CURDATE);
  44.   CMDLINE := NULL;
  45.   SOURCE.TRAP := TRUE;
  46.   ERROR := PPMUQQ (0,ADR NULL,CMDLINE);
  47.   IF CMDLINE = NULL THEN    {FILENAME WAS NOT GIVEN ON COMMAND LINE}
  48.      BEGIN
  49.         WRITE (OUTPUT, 'MSB>  FILE? ');
  50.         SOURCE.TRAP := TRUE;
  51.         READFN (INPUT, SOURCE);    {READ AND ASSIGN FILENAME}
  52.      END
  53.   ELSE   {ASSIGN THE NAME BY HAND}
  54.      ASSIGN (SOURCE,CMDLINE);
  55.   RESET (SOURCE);
  56.   IF SOURCE.ERRS <> 0 THEN
  57.      BEGIN
  58.         WRITELN (OUTPUT, 'MSB>  *** File Not Found, or Disk Error');
  59.         ENDXQQ
  60.      END;
  61.   PGCNT := 00;
  62.   LNCNT := 00;
  63.   WDCNT := 00;
  64.   CHCNT := 00;
  65. END;   {PROCEDURE}
  66.  
  67. PROCEDURE SCANFILE;
  68. VAR
  69.   I : INTEGER;
  70.   C : CHAR;
  71. BEGIN
  72.   C := BLANK;
  73.   I := 00;
  74.   WHILE NOT EOF (SOURCE) DO
  75.      BEGIN
  76.         WHILE NOT EOF(SOURCE) AND NOT (C IN ALPHA) DO
  77.            BEGIN
  78.               IF EOLN (SOURCE) THEN LNCNT := LNCNT + 1;
  79.               READ (SOURCE, C); CHCNT := CHCNT + 1;
  80.            END;
  81.         WHILE NOT EOF(SOURCE) AND (C IN ALPHA) DO
  82.            BEGIN
  83.               IF EOLN (SOURCE) THEN LNCNT := LNCNT + 1;
  84.               CHCNT := CHCNT + 1;  I := I + 1;
  85.               IF I <= WRDLEN THEN
  86.                  NEW_WRD [I] := C;
  87.               READ (SOURCE, C)
  88.            END;
  89.         IF I > 0 THEN
  90.            BEGIN
  91.               I := 0;
  92.               WDCNT := WDCNT + 1
  93.            END
  94.      END
  95. END;  {PROCEDURE}
  96.  
  97. BEGIN  {MAIN}
  98.   INITIALIZE;
  99.   WRITELN (OUTPUT, 'MSB>  *IN PROGRESS    ',CURDATE,NULL:1,CURTIME);
  100.   SCANFILE;
  101.   PGCNT := LNCNT DIV PGLINES;
  102.     CHCNT := CHCNT - LNCNT;    {CARRIAGE RETURN CHARS HAVE BEEN INCLUDED}
  103.   IF LNCNT MOD PGLINES <> 00 THEN PGCNT := PGCNT + 1;
  104.   WRITELN (OUTPUT,NULL:10,'LINES:   WORDS:    CHARS:    PAGES:');
  105.   WRITELN (OUTPUT,NULL:10,'-----    -----     -----     -----');
  106.   WRITELN (OUTPUT,NULL:10,LNCNT:5,NULL:4,WDCNT:5,NULL:5,CHCNT:5,NULL:5,PGCNT:5);
  107. END.
  108.